COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "3DNET"
C00009 ENDMK
C⊗;
BEGIN "3DNET"
REQUIRE "DDHDR.SAI[GRA,HPM]" SOURCE_FILE;
REAL  X,Y,Z,XP,YP,ZP,CXC,CYC,CZC,MA,MB,MC,MD,ME,MF,MG,MH,MI;
INTEGER PORTS,LEVELS,ROWS,I,J,K,L,M,N,WID,HIG,C,D;


PROCEDURE MAKROT(REAL CX,CY,CZ);
    BEGIN
    REAL W,SW,CW,OMCW;
    W←SQRT(CX↑2+CY↑2+CZ↑2);
    SW←SIN(W); CW←COS(W); CX←CX/W; CY←CY/W; CZ←CZ/W; OMCW←1-CW;
    MA←(CW+OMCW*CX↑2); MB←(OMCW*CX*CY-CZ*SW); MC←(OMCW*CX*CZ+CY*SW);
    MD←(OMCW*CX*CY+CZ*SW); ME←(CW+OMCW*CY↑2); MF←(OMCW*CY*CZ-CX*SW);
    MG←(OMCW*CX*CZ-CY*SW); MH←(OMCW*CY*CZ+CX*SW); MI←(CW+OMCW*CZ↑2);
    END;

PROCEDURE ROTATE(REAL X,Y,Z; REFERENCE REAL XO,YO,ZO);
    BEGIN
    XO←MA*X+MB*Y+MC*Z;
    YO←MD*X+ME*Y+MF*Z;
    ZO←MG*X+MH*Y+MI*Z;
    END;

OUTSTR("DD CHAN "&CVOS(C←GDDCHN(-1))&" "&CVOS(D←GDDCHN(-1))&'15&'12);

WHILE TRUE DO
    BEGIN "LOOP"
    DDINIT;
    MAKROT(CXC←RAN(0), CYC←RAN(0), CZC←RAN(0));
    OUTSTR("PORTS:"); PORTS←CVD(INCHWL);
    OUTSTR("LEVELS:"); LEVELS←CVD(INCHWL);
    ROWS←PORTS↑(LEVELS-1);
    SCREEN(-.7,-.7,.7,.7);
    DRKEN; RECTAN(-1000,-1000,1000,1000); LITEN;
        BEGIN "ARRAY"
        REAL ARRAY LX,LY[0:LEVELS-1,0:ROWS-1];

        FOR I←0 STEP 1 UNTIL LEVELS-1 DO
            BEGIN
            WID←ROWS/PORTS↑I;
            HIG←ROWS/WID;
            Z←-(WID-1)/2;
            Y←-(HIG-1)/2;
            X←ROWS*(I-(LEVELS-1)/2)/LEVELS;
            FOR K←0 STEP 1 UNTIL WID-1 DO
            FOR J←0 STEP 1 UNTIL HIG-1 DO
                BEGIN
                ROTATE(X,Y+J,Z+K,XP,YP,ZP);
                ZP←ZP+ROWS;
                LX[I,J+K*HIG]←XP/ZP;
                LY[I,J+K*HIG]←YP/ZP;
                ELLIPS((XP-.3)/ZP,(YP-.3)/ZP,(XP+.3)/ZP,(YP+.3)/ZP);
                END;
            IF I>0 THEN BEGIN SHOWA(D); SHOWS(C); END;
            DPYUP(C); DPYUP(C); D↔C;
            IF I≠0 THEN
                BEGIN
                FOR K←0 STEP 1 UNTIL ROWS-1 DO
                FOR L←0 STEP 1 UNTIL PORTS-1 DO
                    BEGIN
                    M←((PORTS*K) MOD (PORTS↑I))+L;
                    M←M+(K-(K MOD (PORTS↑I)));
                    LINE(LX[I-1,K],LY[I-1,K],
                        LX[I,M],
                        LY[I,M]);
                    END;
                END;
            SHOWA(D); SHOWS(C); DPYUP(C); DPYUP(C); D↔C;
            END;

        FOR I←0 STEP 1 UNTIL ROWS-1 DO
            BEGIN
            REAL XB,YB,ZB,SX,SY,SX1,SY1;
            XB←ROWS*(-LEVELS+1)/(2*LEVELS);
            YB←0;
            ZB←I-(ROWS-1)/2;
            ROTATE(XB,YB,ZB,XP,YP,ZP);
            ZP←ZP+ROWS; SX←XP/ZP; SY←YP/ZP;
            ROTATE(-XB,ZB,YB,XP,YP,ZP);
            ZP←ZP+ROWS; SX1←XP/ZP; SY1←YP/ZP;
            FOR J←0 STEP 1 UNTIL PORTS-1 DO
                BEGIN

                X←ROWS*(-.3-(LEVELS-1)/2)/LEVELS;
                Z←ZB-1/2+1/(2*PORTS)+J/PORTS;
                Y←0;
                ROTATE(X,Y,Z,XP,YP,ZP);
                ZP←ZP+ROWS;
                LINE(SX,SY,XP/ZP,YP/ZP);
                ELLIPS((XP-.15)/ZP,(YP-.15)/ZP,(XP+.15)/ZP,(YP+.15)/ZP);
                ROTATE(-X,Z,Y,XP,YP,ZP);
                ZP←ZP+ROWS;
                LINE(SX1,SY1,XP/ZP,YP/ZP);
                ELLIPS((XP-.15)/ZP,(YP-.15)/ZP,(XP+.15)/ZP,(YP+.15)/ZP);
                END;
            SHOWA(D); SHOWS(C); DPYUP(C); DPYUP(C); D↔C;
            END;
         SHOWA(D);

         IF (INCHRW LAND '137)="X" THEN
            BEGIN
            PUTMIT("3DNET.SU[TMP,HPM]");
            SHOWA(-1);
            OUTSTR(" xgping ... "&'15&'12);
            XGPUP(-4);
            END;
         CLRBUF; SHOW(-1); RDDCHN(C);
         END "ARRAY";
    END "LOOP";
END;